home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / s_to_z / ukeyd1 / unikeyu4.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  7.5 KB  |  243 lines
  1. unit Unikeyu4;
  2.  
  3. (*
  4.   TUniKey demonstration program. 
  5.   Copyright 1995, Demosphere International, Inc.
  6.  
  7.   This program exercises the UniKey component in a stand-alone or
  8.   multi-user environment. It surfaces most of the options a programmer
  9.   can control into a convenient form interface.
  10.  
  11.   This program can only be recompiled if you have the UNIKEY.DCU or
  12.   UNIKEY.PAS files, or place the UniKey component on the form.
  13.  
  14.   You can try your own key table with this demo. Just create a Paradox
  15.   .DB file, structuring it with one or more numeric fields. Edit this
  16.   file and create one record with the starting key values in each field.
  17.   For example: Customer=1001, Order=250, Item=701.
  18.   Then in the demo program, each time you ask for a new key, refer to
  19.   the desired field by its number: customer key is field 0, etc.
  20.   Note that only the first record is used to store all keys.
  21.  
  22.   For a network-based test, place the key table in a directory that all
  23.   workstations have read/write access to, and then run the demo program
  24.   on several workstations. Use the Beep and Continuous testing options.
  25.   This will let you see how often collisions occur, and let you gauge
  26.   the best value for MaxRetries.
  27.  
  28. *)
  29.  
  30. interface
  31.  
  32. uses
  33.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  34.   Forms, DB, DBTables, StdCtrls, Unikey, ExtCtrls;
  35.  
  36. type
  37.   TForm1 = class(TForm)
  38.     Button1: TButton;
  39.     Button2: TButton;
  40.     GroupBox1: TGroupBox;
  41.     Edit3: TEdit;
  42.     Edit4: TEdit;
  43.     Label6: TLabel;
  44.     Label7: TLabel;
  45.     GroupBox2: TGroupBox;
  46.     CheckBox1: TCheckBox;
  47.     CheckBox2: TCheckBox;
  48.     CheckBox3: TCheckBox;
  49.     Label4: TLabel;
  50.     Edit1: TEdit;
  51.     Label5: TLabel;
  52.     Edit2: TEdit;
  53.     GroupBox3: TGroupBox;
  54.     Label1: TLabel;
  55.     Label2: TLabel;
  56.     Label3: TLabel;
  57.     Label8: TLabel;
  58.     Edit5: TEdit;
  59.     Bevel1: TBevel;
  60.     Bevel2: TBevel;
  61.     Bevel3: TBevel;
  62.     CheckBox4: TCheckBox;
  63.     Label9: TLabel;
  64.     Button3: TButton;
  65.     procedure Button1Click(Sender: TObject);
  66.     procedure FormCreate(Sender: TObject);
  67.     procedure Button2Click(Sender: TObject);
  68.     procedure Button3Click(Sender: TObject);
  69.   private
  70.     { Private declarations }
  71.     UniKey1:TUniKey; {remove if component is placed on form}
  72.     goodkeys:longint;
  73.     FRunning:boolean;
  74.     procedure SetRunning(const Running:boolean);
  75.     procedure UniKey1MaxRetries(Sender:TObject; var KeepTrying:boolean);
  76.     procedure UniKey1NewKey(Sender: TObject);
  77.     property Running:boolean read FRunning write SetRunning;
  78.   public
  79.     { Public declarations }
  80.   end;
  81.  
  82. var
  83.   Form1: TForm1;
  84.  
  85. implementation
  86.   Uses dbitypes, Dialogs, UniKeyA4;
  87.  
  88. {$R *.DFM}
  89.  
  90. function NumKeyToAlpha(const i:longint):string;
  91. {
  92.   This is an example of changing a sequential numerical key value into a
  93.   special alphanumeric key. The AllowableChars constant gives the
  94.   "collating sequence" of the characters that are allowed to be used.
  95.   Each "digit" of the result is one of the characters from this string
  96.   only. When the last character is used in any "digit" position, the next
  97.   higher "digit" is incremented in the result.
  98. }
  99. const
  100.   AllowableChars='abcdefGHIJK123456';
  101.   x:string[length(AllowableChars)]=AllowableChars;
  102. var
  103.   m:integer;
  104.   j:longint;
  105.   k:longint;
  106.   r:integer;
  107. begin
  108.   Result:='';
  109.   m:=length(AllowableChars);
  110.   j:=i;
  111.   repeat
  112.     r:=j mod m; {remainder gives "digit" to be used in result}
  113.     j:=j div m; {amount left for higher place "digits"}
  114.     Result:=x[r+1]+Result;
  115.   until (j=0) or (length(Result)>10);
  116.   end; {NumKeyToAlpha}
  117.  
  118. procedure TForm1.SetRunning(const Running:boolean);
  119. {adjust all visible controls for "running" state}
  120. begin
  121.   if FRunning<>Running then begin
  122.     FRunning:=Running;
  123.     Button1  .Enabled:=not Running;
  124.     Button2  .Enabled:=not Running;
  125.     Button3  .Enabled:=not Running;
  126.     CheckBox1.Enabled:=not Running;
  127.     CheckBox3.Enabled:=not Running;
  128.     CheckBox4.Enabled:=not Running;
  129.     end;
  130.   end; {SetRunning}
  131.  
  132. procedure TForm1.UniKey1MaxRetries(Sender:TObject; var KeepTrying:boolean);
  133. {Example of a user-defined MaxRetries event handler}
  134. begin
  135.   KeepTrying:=MessageDlg((Sender as TUniKey).TableName+':'#13+
  136.                   'Table may be temporarily locked by another user.'#13+
  137.                   'Press OK to try again, '#13+
  138.                   'or Cancel to terminate request for new key.',
  139.                   mtInformation,[mbOK,mbCancel],0)=IDOK;
  140.   end; {UniKey1MaxRetries}
  141.  
  142. procedure TForm1.Button1Click(Sender: TObject);
  143. var
  144.   success:boolean;
  145.   status:string;
  146.  
  147.   procedure ShowStatus;
  148.   begin
  149.     if status='' then
  150.       case success of
  151.         true :status:='ok';
  152.         false:status:='unknown failure';
  153.         end;
  154.     Label1.Caption:='Status: '+status;
  155.     end; {ShowStatus}
  156.  
  157. begin
  158.   if Running then exit; {prevent any undesired reentry from extra click messages}
  159.   Running:=true;
  160.   success:=false;
  161.   status:='';
  162.   UniKey1:=TUniKey.Create(Self); {remove if component on form}
  163.   try try
  164.     {Override most UniKey properties with values set on form}
  165.     with UniKey1 do begin
  166.       DatabaseName:=Edit3.Text;
  167.       TableName   :=Edit4.Text;
  168.       FieldNo     :=StrToInt(Edit2.Text);
  169.       MaxRetries  :=StrToInt(Edit5.Text);
  170.       OnMaxRetries:=UniKey1MaxRetries; {user-defined MaxRetries event handler}
  171.       BeepOnLock  :=CheckBox1.Checked;
  172.       Reserve     :=StrToInt(Edit1.Text);
  173.       if CheckBox3.Checked then
  174.         OnNewKey:=UniKey1NewKey {user-defined NewKey event handler}
  175.       else
  176.         OnNewKey:=nil; {remove any user-defined event handler}
  177.       end;
  178.     repeat {for continuous testing, until checkbox is not checked}
  179.       if CheckBox2.Checked then
  180.         CheckBox2.Caption:='Test continuously (click to stop)';
  181.       try
  182.         success:=false;
  183.         {the calls to NewKey in the next statement actually obtain the key}
  184.         if CheckBox4.Checked then
  185.           Label2.Caption:='New key: '+NumKeyToAlpha(UniKey1.NewKey)
  186.         else
  187.           Label2.Caption:='New key: '+IntToStr(UniKey1.NewKey);
  188.         {any exception raised by NewKey will skip next lines}
  189.         with UniKey1 do begin
  190.           Open;
  191.           Label9.Caption:='Key Field: '+Fields[FieldNo].FieldName;
  192.           Close;
  193.           end;
  194.         success:=true;
  195.         inc(goodkeys); {count number of keys successfully obtained}
  196.       except
  197.         {eat this exception because we already used an OnMaxRetries handler}
  198.         on EUniKeyMaxRetries do
  199.           status:='Max retries';
  200.         end;
  201.       ShowStatus;
  202.       Label3.Caption:='Keys obtained: '+IntToStr(goodkeys);
  203.       Application.ProcessMessages;
  204.     until not CheckBox2.Checked; {for continuous testing}
  205.   except
  206.     on E:Exception do
  207.       if status='' then
  208.         status:=E.Message
  209.     end;
  210.   finally
  211.     ShowStatus;
  212.     UniKey1.Free; {remove if component on form}
  213.     CheckBox2.Caption:='Test continuously';
  214.     CheckBox2.Checked:=false;
  215.     Running:=false;
  216.     end;
  217.   end; {Button1Click}
  218.  
  219. procedure TForm1.FormCreate(Sender: TObject);
  220. begin
  221.   goodkeys:=0; {prepare to count number of keys successfully obtained}
  222.   end;
  223.  
  224. procedure TForm1.UniKey1NewKey(Sender: TObject);
  225. {Example of custom NewKey handler - this one causes decrementing keys to
  226. be generated instead of the default increment-by-one scheme}
  227. begin
  228.   with UniKey1 do
  229.     NewKey:=OldKey-1;
  230.   end; {UniKey1NewKey}
  231.  
  232. procedure TForm1.Button2Click(Sender: TObject);
  233. begin
  234.   Close
  235. end;
  236.  
  237. procedure TForm1.Button3Click(Sender: TObject);
  238. begin
  239.   AboutBox.ShowModal;
  240. end;
  241.  
  242. end.
  243.